home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
jx4nt123.zip
/
UTILS
/
EDITOR.UTF
(
.txt
)
next >
Wrap
Null Bytes Alternating
|
1994-08-21
|
20KB
|
354 lines
\ editor.F .. Unicode BLOCK file editor for Jax4th
\ Copyright (c)1994 Jack J. Woehr
\ P.O. Box 51, Golden, Colorado 80402-0051
\ jax@well.sf.ca.us 72203.1320@compuserve.com
\ SYSOP RCFB (303) 278-0364 2400/9600/14400
\ All Rights Reserved
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ This is free software and can be modified and redistributed under
\ certain conditions described in the file COPYING.TXT. The
\ Disclaimer of Warranty and License for this free software are also
\ contained in the file COPYING.TXT.
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\
\ $Revision: 1.2 $
\
MARKER editor.utf
\ ~~~~~~~~~~~~~~~~~~~~
\ Conditional INCLUDED
\ ~~~~~~~~~~~~~~~~~~~~
: PROVIDES ( c-addr u "ccc< >" --)
BL WORD FIND NIP 0=
IF INCLUDED ELSE 2DROP THEN ;
S" UTILS\UTILS.UTF" PROVIDES USEFUL
S" UTILS\SYSCALLS.UTF" PROVIDES LIBRARY
CR .( Loading Editor) CR
USEFUL DECIMAL
\ ~~~~~~~~~~~~~~~~~~~~~~~
\ Some classic keystrokes
\ ~~~~~~~~~~~~~~~~~~~~~~~
: N ( --) 1 SCR +! ;
: B ( --) -1 SCR +! ;
: L ( --) SCR @ LIST ;
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~
\ Screen and shadow commands
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~
\ Number of BLOCKs in a file.
: CAPACITY ( -- u)
BLOCK-FILE @ FILE-SIZE
0<> -37 AND THROW
1024 CHARS UM/MOD NIP ;
\ Switch to the Alternate (shadow) BLOCK
: A ( --)
CAPACITY DUP 0 2 UM/MOD NIP
SCR @ + 0 ROT UM/MOD DROP SCR ! ;
\ Clean a screen.
: WIPE ( --)
SCR @ BLOCK 1024 BL FILL ;
\ This should have been in the Standard, really.
\ Copy one screen to another
: COPY ( u1 u2 --)
SWAP BLOCK SWAP BLOCKNUM !
UPDATE SAVE-BUFFERS DROP ;
\ This is kinda cheating based on our one-buffer system.
\ Close the file whose fid is in BLOCK-FILE
: CLOSE ( --)
BLOCK-FILE @ CLOSE-FILE
0<> -37 AND THROW
0 BLOCK-FILE ! ;
\ Un-UPDATE a screen.
: DISCARD ( --) FALSE UPDATED ! ;
INTERNALS-WORDLIST ALSO-WID DEFINITIONS
\ Opening a BLOCK file.
: (OPEN) ( mode c-addr u --)
ROT OPEN-FILE
0<> -37 AND THROW
BLOCK-FILE ! ;
PREVIOUS DEFINITIONS INTERNALS-WORDLIST ALSO-WID
\ A wrapper for the above.
: OPEN ( mode "ccc< >" --)
BL WORD COUNT PAD PLACE PAD COUNT (OPEN) ;
\ Usable in compilation.
: [OPEN] ( Compile: "ccc< >" -- Execution: mode --)
BL WORD COUNT
POSTPONE SLITERAL
POSTPONE (OPEN)
; IMMEDIATE
USEFUL
VOCABULARY EDITOR
ALSO EDITOR DEFINITIONS
1024 CONSTANT CHARS/BLOCK
64 CONSTANT CHARS/LINE
: S@B ( -- a-addr) SCR @ BLOCK ;
PREVIOUS DEFINITIONS
DECIMAL
USEFUL ALSO EDITOR DEFINITIONS
VARIABLE CURSOR
: !CURSOR ( n --) S>D 1024 FM/MOD DROP CURSOR ! ;
\ convert cursor value to data space address of that character
: CURSORTOXY ( n -- x y)
CHARS/LINE /MOD 1+ ( header)
SWAP 3 + SWAP ( margin) ;
: CURSOR++ ( --) CURSOR @ 1+ !CURSOR ;
: CURSOR-- ( --) CURSOR @ 1- !CURSOR ;
: ATCURSOR ( --) CURSOR @ CURSORTOXY AT-XY ;
: CURSORTODATA ( cursor - c-addr) S@B SWAP CHARS + ;
: GOODCURSOR ( n1 -- n2) S>D 1024 FM/MOD DROP ;
: DRAW-LONG-BLOCK ( cursor -- count)
GOODCURSOR 0
?DO I CURSORTODATA C@ I CURSORTOXY AT-XY EMIT LOOP
ATCURSOR ;
: PROMPTLINE ( --) L 0 17 AT-XY ;
HEX
: MINIBUFF ( --)
PROMPTLINE ." Forth: " PAD 7F ACCEPT PAD SWAP EVALUATE
CR ." Press any key ..." KEY DROP ;
DECIMAL
\ Move a region of the editing screen
\ slide a block from cursor pos 1 to cursor pos 2 of n size
\ save current cursor
\ move n aside and verify validty of two cursor arguments
\ extra copy
: SLIDE ( cursor1 cursor2 n --)
CURSOR @ >R \ c1 c2 nr: c-
>R GOODCURSOR SWAP GOODCURSOR SWAP \ c1 c2 r: c n
2DUP \ c1 c2r: c n
SWAP CHARS S@B + OVER CHARS S@B + \ c2 c1' c2' r: c n
ROT 1023 SWAP - R@ MIN CHARS MOVE \ c1' r: c n
R> DRAW-LONG-BLOCK \ r: c
R> CURSOR ! \ r:
;
: NOESCPDEF ( char --) DROP ATCURSOR ;
: ESC-X ( char --) DROP MINIBUFF L ATCURSOR ;
HEX USEFUL ALSO EDITOR DEFINITIONS
CREATE ESCAPEKEYS
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 00
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 10
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 20
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 30
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 40
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 50
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' ESC-X , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 60
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 70
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' ESC-X , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
DECIMAL USEFUL ALSO EDITOR DEFINITIONS
: ESCPDEF ( 1bH -- char)
DROP ( passed-in char)
PROMPTLINE ." ESC-" KEY DUP EMIT ;
HEX USEFUL ALSO EDITOR DEFINITIONS
80 CONSTANT #ESCAPEKEYS
: /ESCAPEKEY ( char -- a-addr)
#ESCAPEKEYS 1- AND CELLS ESCAPEKEYS + ;
: ESCAPEKEY ( char --)
DUP /ESCAPEKEY @ EXECUTE ;
DECIMAL USEFUL ALSO EDITOR DEFINITIONS
: EDITDEF ( char --)
DUP EMIT
S@B CURSOR @ S>D
CHARS/BLOCK FM/MOD DROP
CHARS + C!
CURSOR++ ATCURSOR UPDATE ;
: NOEDITDEF ( char --) DROP ATCURSOR ;
VARIABLE EDITING
: EDITEXIT ( char --) DROP FALSE EDITING ! ;
: EDITBS ( 8 --)
DROP CURSOR-- ATCURSOR
BL EDITDEF CURSOR-- ATCURSOR
UPDATE
;
CREATE TABSPACE 2 CELLS ALLOT
: EDITC-A ( 1 --)
DROP CURSOR @ 0 CHARS/LINE FM/MOD NIP CHARS/LINE * !CURSOR
S@B CURSOR @ CHARS + CHARS/LINE BL SKIP NIP
CHARS/LINE SWAP - 0 CHARS/LINE FM/MOD DROP CURSOR +!
CURSOR @ + !CURSOR ATCURSOR ;
: EDITC-B ( 2 --) DROP CURSOR-- ATCURSOR ;
: EDITC-D ( 4 --) DROP ATCURSOR ;
: EDITC-E ( 5 --)
DROP CURSOR @ 0 CHARS/LINE FM/MOD NIP CHARS/LINE *
CHARS/LINE 1- + S@B SWAP -TRAILING NIP
!CURSOR ATCURSOR ;
: EDITC-F ( 6 --)
DROP CURSOR++ ATCURSOR ;
: EDITC-L ( 12 --)
DROP PAGE L ATCURSOR ;
: EDITC-N ( 14 --)
DROP CURSOR @ CHARS/LINE + !CURSOR ATCURSOR ;
: EDITC-P ( 16 --)
DROP CURSOR @ CHARS/LINE - !CURSOR ATCURSOR ;
: EDITC-V ( 22 --) DROP ATCURSOR ;
: EDITC-[ ( 27 --) ESCPDEF ESCAPEKEY ;
HEX USEFUL ALSO EDITOR DEFINITIONS
CREATE EDITKEYS
' NOEDITDEF , ' EDITC-A , ' EDITC-B , ' NOEDITDEF , \ 00
' EDITC-D , ' EDITC-E , ' EDITC-F , ' NOEDITDEF ,
' EDITBS , ' NOEDITDEF , ' NOEDITDEF , ' NOEDITDEF ,
' EDITC-L , ' EDITC-N , ' EDITC-N , ' NOEDITDEF ,
' EDITC-P , ' NOEDITDEF , ' NOEDITDEF , ' NOEDITDEF , \ 10
' NOEDITDEF , ' NOEDITDEF , ' EDITC-V , ' NOEDITDEF ,
' NOEDITDEF , ' NOEDITDEF , ' EDITEXIT , ' EDITC-[ ,
' NOEDITDEF , ' NOEDITDEF , ' NOEDITDEF , ' NOEDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF , \ 20
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF , \ 30
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF , \ 40
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF , \ 50
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF , \ 60
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF , \ 70
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
' EDITDEF , ' EDITDEF , ' EDITDEF , ' EDITDEF ,
HEX USEFUL ALSO EDITOR DEFINITIONS
80 CONSTANT #EDITKEYS
: /EDITKEY ( char -- a-addr)
#EDITKEYS 1- AND CELLS EDITKEYS + ;
: EDITKEY ( char --) DUP /EDITKEY @ EXECUTE ;
DECIMAL USEFUL ALSO EDITOR DEFINITIONS
: ED.INIT ( --)
TRUE EDITING !
CURSOR @ !CURSOR
PAGE L ATCURSOR ;
: EDITING ( --)
BEGIN
EDITING @
WHILE
KEY EDITKEY
REPEAT
0 17 AT-XY
UPDATED @
IF
." UPDATEd"
ELSE
." Not UPDATEd."
THEN CR
;
: ED ( --) ED.INIT EDITING ;
: EDIT ( u --) 1 ?ENOUGH SCR ! ED ;
USEFUL ALSO EDITOR
: ED ED ;
: EDIT EDIT ;
USEFUL
\ ~~~~~~~~~~~~~~~
\ End of editor.f
\ ~~~~~~~~~~~~~~~